perm filename PIX.SAI[CMS,LCS] blob
sn#110946 filedate 1974-07-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "SLAVE"
C00004 00003 SUBR PULP
C00008 00004 SUBR WAVE
C00012 ENDMK
C⊗;
BEGIN "SLAVE"
REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;
DEFINE α="COMMENT";
DEFINE π="3.1415927";
DEFINE SUBR="SIMPLE PROCEDURE";
DEFINE ISUBR="SIMPLE INTEGER PROCEDURE";
DEFINE THRU="STEP 1 UNTIL";
DEFINE ⊂="BEGIN";
DEFINE ⊃="END";
INTEGER BOY,MAN,HD,RA,LA,RS,LS,RH,LH,LP;
INTEGER RT,LT,RL,LL,RF,LF,LC,DOWN,UP,IP;
REAL TA,BM,DG,DB,RB,BA,RN;
SUBR INIT; α INITIALIZATION;
BEGIN "INIT"
MKUNIV;GEODPY;
BOY←INB3D("LYN[CMS,LCS]");
MAN←FDNAME("GIRL");
HD←FDNAME("HD");
RA←FDNAME("RA");
LA←FDNAME("LA");
RL←FDNAME("RL");
LL←FDNAME("LL");
RF←FDNAME("RF");
LF←FDNAME("LF");
RS←FDNAME("RS");
LS←FDNAME("LS");
RT←FDNAME("RT");
LT←FDNAME("LT");
RH←FDNAME("RH");
LH←FDNAME("LH");
GEODPY;LC ← INCHRW;
IF LC="P" THEN BEGIN
IP ← IP+1;OUTSTR("FRAME "&CVS(IP));
PLOTO("JOAN."&CVS(IP));LP ← -1;⊃;
END "INIT";
SUBR PULP;
BEGIN "PULP"
IF LP<0 THEN BEGIN IP ← IP+1;SHOW2(0,1);
OUTSTR("FRAME "&CVS(IP));PLOTO("JOAN."&CVS(IP));
RETURN;⊃;
GEODPY;
RETURN;
END "PULP";
SUBR NOD;
BEGIN "NOD"
INTEGER I,L;
RN ← -RN;
FOR L←1 THRU 2 DO
⊂ RN ← -RN;
FOR I←1 THRU 4 DO
⊂ ROTATE(-HD,0,RN,0);PULP;⊃;⊃;
RETURN;
END "NOD";
SUBR BEND(INTEGER ID);
BEGIN "BEND"
INTEGER I;
IF ID≥0 THEN ⊂ DB ← -DB;RB ← -RB;BA ← -BA;⊃;
FOR I←1 THRU 3 DO
⊂ ROTATE(-MAN,DB,0,0);ROTATE(-LT,DB,0,0);
TRANSL(-MAN,0,RB,BA);ROTATE(-RT,-DB,0,0);
PULP;⊃;
IF ID≥0 THEN ⊂ DB ← -DB;RB ← -RB;BA ← -BA;⊃;
RETURN;
END "BEND";
SUBR ARMS;
BEGIN "ARMS"
INTEGER K;
FOR K←1 THRU 4 DO
⊂ ROTATE(-RA,-BM,0,0);ROTATE(-LA,BM,0,0);PULP;⊃;
BM ← -BM;RETURN;
END "ARMS";
SUBR ROND;
BEGIN "ROND"
TA ← -TA;
WHILE TRUE DO
⊂ ROTATE(-MAN,0,TA,0);PULP;
LC ← INCHRS;
IF LC≥0 THEN RETURN;⊃;
END "ROND";
SUBR WALK;
BEGIN "WALK"
INTEGER I;
REAL DW,DQ,DF,DK;
DK ← π*4/180;
DF ← -.07;
DW ← π*8/180;
DQ ← π*7/180;
BEGIN "STAR"
ARMS;
FOR I←1 THRU 5 DO
⊂ ROTATE(-RT,-DW,0,0);ROTATE(-LT,-DW,0,0);
ROTATE(-RL,DK,0,0);ROTATE(-LL,-DK,0,0);
ROTATE(-LS,DQ,0,0);ROTATE(-RS,DQ,0,0);
ROTATE(-HD,0,-DW,0);TRANSL(-MAN,0,DF,.47);PULP;⊃;
WHILE TRUE DO
BEGIN "FOREVER"
INTEGER K;
DW ← -DW;
DQ ← -DQ;
FOR K←1 THRU 2 DO
⊂ DF ← -DF;DK ← -DK;
FOR I←1 THRU 5 DO
⊂ ROTATE(-RT,-DW,0,0);ROTATE(-LT,-DW,0,0);
TRANSL(-MAN,0,DF,.47);ROTATE(-RL,DK,0,0);
ROTATE(-HD,0,-DW,0);ROTATE(-LL,-DK,0,0);
ROTATE(-LS,DQ,0,0);ROTATE(-RS,DQ,0,0);PULP;⊃;
LC ← INCHRS;
IF LC≥0 THEN BEGIN
IF K=1 THEN ⊂ ARMS;RETURN;⊃;
DW ← -DW;DQ ← -DQ;DF ← -DF;DK ← -DK;
FOR I←1 THRU 5 DO
⊂ ROTATE(-RT,-DW,0,0);ROTATE(-LT,-DW,0,0);
ROTATE(-RL,DK,0,0);ROTATE(-LL,-DK,0,0);
ROTATE(-LS,DQ,0,0);ROTATE(-RS,DQ,0,0);
ROTATE(-HD,0,-DW,0);TRANSL(-MAN,0,DF,.47);PULP;⊃;
ARMS;RETURN;⊃;
END;
END "FOREVER";
END "STAR";
END "WALK";
SUBR FALL;
BEGIN "FALL"
INTEGER L,K;
REAL DW,DN;
DW ← π*20/180;
DN ← -.5;
FOR K←1 THRU 2 DO
⊂ FOR L←1 THRU 10 DO
⊂ ROTATE(-MAN,0,0,DW);TRANSL(-MAN,DN,0,0);
TRANSL(MAN,0,DN,0);GEODPY;⊃;
FOR L←1 THRU 14 DO
⊂ TRANSL(MAN,0,DN,0);GEODPY;⊃;
DW ← -DW;DN ← -DN;
END;
RETURN;
END "FALL";
SUBR WAVE;
BEGIN "WAVE"
INTEGER I,L,K;
REAL DH,BN;
DH ← π/12;
BN ← π/8;
ARMS;
FOR I←1 THRU 4 DO
⊂ ROTATE(-RS,0,0,-BN);
ROTATE(-RA,0,0,-BN);PULP;⊃;
WHILE TRUE DO
BEGIN "HII"
FOR L←1 THRU 2 DO
⊂ DH ← -DH;
FOR I←1 THRU 2 DO
⊂ DH ← -DH;
FOR K←1 THRU 2 DO
⊂ ROTATE(-RA,-DH,0,0);PULP;⊃;⊃;⊃;
LC ← INCHRS;
IF LC≥0 THEN BEGIN
FOR I←1 THRU 4 DO
⊂ ROTATE(-RA,0,0,BN);
ROTATE(-RS,0,0,BN);PULP;⊃;
ARMS;
RETURN;
END;
END "HII";
END "WAVE";
SUBR DECA;
BEGIN "DECA"
INTEGER K,I;
REAL DC;
DC ← π/8;
FOR K←1 THRU 2 DO
⊂ ROTATE(-RA,-DC,0,0);ROTATE(-LA,DC,0,0);PULP;⊃;
DC ← -DC;
FOR K←1 THRU 4 DO
⊂ ROTATE(-RS,DC,0,0);ROTATE(-LS,DC,0,0);PULP;⊃;
ARMS;
FOR K←1 THRU 2 DO
⊂ ROTATE(-RH,0,0,-DG);ROTATE(-LH,0,0,DG);
ROTATE(-RA,0,0,DG);ROTATE(-LA,0,0,DG);PULP;⊃;
DG ← DG*2;
DC ← -DC;
BATT(HD,RH);
FOR I←1 THRU 4 DO
⊂ ROTATE(-RA,0,0,-DG);ROTATE(-LA,0,0,-DG);
ROTATE(-RA,-DC,0,0);ROTATE(-LA,-DC,0,0);
ROTATE(-RA,0,0,-DG);ROTATE(-LA,0,0,DG);PULP;⊃;
BEND(DOWN);
DG ← DG/2;
FOR K←1 THRU 2 DO
⊂ ROTATE(-RA,0,0,DG);ROTATE(-LA,0,0,-DG);
ROTATE(-RA,-DC,0,0);ROTATE(-LA,-DC,0,0);
ROTATE(-RA,0,0,-DG);ROTATE(-LA,0,0,DG);PULP;⊃;
BEND(DOWN);BEND(DOWN);BDET(HD);
FOR K←1 THRU 2 DO
⊂ ROTATE(-RA,0,0,DG);ROTATE(-LA,0,0,-DG);
TRANSL(HD,0,-.3,0);
ROTATE(-RS,DC,0,0);ROTATE(-LS,DC,0,0);
ROTATE(-RH,0,0,DG);ROTATE(-LH,0,0,-DG);PULP;⊃;
BEND(UP);BEND(UP);
FOR K←1 THRU 2 DO
⊂ ROTATE(-RS,DC,0,0);ROTATE(-LS,DC,0,0);PULP;⊃;
BEND(UP);BM ← -BM;
RETURN;
END "DECA";
SUBR COMND;
BEGIN "COMND"
INTEGER I;
DG ← π/16;
TA ← π/24;
DB ← π/16;
BA ← .06;
DOWN ← -1;
UP ← 1;
RB ← -.01;
RN ← π/16;
BM ← π/8;
IP ← 0;
LP ← 1;
IF LC="P" THEN ⊂ IP ← 1;LP ← -1;⊃;
WHILE TRUE DO
BEGIN "FIGER"
LC ← INCHRW;
IF LC="G" THEN GEOMED;
IF LC="T" THEN ROND;
IF LC="R" THEN WALK;
IF LC="N" THEN NOD;
IF LC="W" THEN WAVE;
IF LC="F" THEN FALL;
IF LC="D" THEN DECA;
IF LC="A" THEN ARMS;
IF LC="B" THEN BEND(DOWN);
IF LC="U" THEN BEND(UP);
IF LC="P" THEN LP ← -LP;
END "FIGER";
END "COMND";
α MAIN EXECUTION;
OUTSTR(12&12&12&12&12);
INIT;
COMND;
END "SLAVE";